home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / a_utils / ffccflow / ffccflow.lha / ffccc+flow / ffccc / STADEF.f < prev    next >
Text File  |  1992-07-31  |  15KB  |  268 lines
  1.       SUBROUTINE STADEF 
  2. *-----------------------------------------------------------------------
  3. *   
  4. *--- initialises the statement classification by reading
  5. *--- the statement descriptions from internal buffers (data 
  6. *--- statement) and filling the necessary arrays.   
  7. *   
  8. *--- output 
  9. *    all variables in common/CLASS/ 
  10. *    SSTM       in COMMON/ALCAZA/   
  11. *    SNAM       in COMMON/ALCAZA/   
  12. *   
  13. *-----------------------------------------------------------------------
  14.       include 'PARAM.h' 
  15.       include 'ALCAZA.h' 
  16.       include 'CLASS.h' 
  17.       include 'FLWORK.h' 
  18.       include 'CONDEC.h' 
  19.       LOGICAL DOITFL
  20.       CHARACTER SDESCR(MXSTAT)*86,STEMP*1,SLAST*1,STR1*24,STR2*20   
  21. *--- SDESCR contains the FORTRAN statement description  
  22. *--- important for new entries: 
  23. *   - scan order is top - down (see e.g. INTEGER - INTEGERFUNCTION etc.)
  24. *   - order is alphabetic   
  25. *   - special characters at the end 
  26. *   
  27. *   The numbers correspond to ISTMDS(6)...ISTMDS(22)
  28. *   
  29. *                         no.+prty+name              descrpt.   
  30. *      l u s x n k h  type information  
  31.       DATA SDESCR(  1)/' 1 0 ASSIGN                  ASSIGN@TO          DEF 
  32.      +99 0 1 1 2 0 0  0  1  0  0  0  0  0  0'/                          DEF 
  33.       DATA SDESCR(  2)/' 3 0 BACKSPACE               DITO               DEF 
  34.      +99 0 0 1 2 2 0  0  2  0 17  0  0  0  0'/                          DEF 
  35.       DATA SDESCR(  3)/' 4 0 BLOCKDATA               DITO               DEF 
  36.      +99 0 0 0 1 2 1  0  1 14  0  0  0  0  0'/                          DEF 
  37.       DATA SDESCR(  4)/' 5 0 BUFFERIN                DITO               DEF 
  38.      +99 0 0 1 2 2 0  0  2  0 17  0  0  0  0'/                          DEF 
  39.       DATA SDESCR(  5)/' 6 0 BUFFEROUT               DITO               DEF 
  40.      +99 0 0 1 2 2 0  0  2  0 17  0  0  0  0'/                          DEF 
  41.       DATA SDESCR(  6)/'15 0 CONTINUE                DITO               DEF 
  42.      +99 0 0 1 0 2 0  0  0  0  0  0  0  0  0'/                          DEF 
  43.       DATA SDESCR(  7)/' 7 0 CALL                    DITO               DEF 
  44.      +99 0 5 1 2 2 0  1  1 15  2  0 17  0  0'/                          DEF 
  45.       DATA SDESCR(  8)/'12 0 COMMON                  DITO               DEF 
  46.      +99 0 0 0 2 2 0 21  1  8  3  0 18 20  0'/                          DEF 
  47.       DATA SDESCR(  9)/'14 0 COMPLEXFUNCTION         COMPLEX#FUNCTION   DEF 
  48.      +99 0 0 0 2 0 1  1  3  4 17 21  2  0 19'/                          DEF 
  49.       DATA SDESCR( 10)/'13 0 COMPLEX                 COMPLEX*@          DEF 
  50.      +99 0 0 0 2 0 0 10  2  4 18  0  0  0  0'/                          DEF 
  51.       DATA SDESCR( 11)/'13 0 COMPLEX                 DITO               DEF 
  52.      +99 0 0 0 2 2 0 10  2  4 18  0  0  0  0'/                          DEF 
  53.       DATA SDESCR( 12)/' 9 0 CHARACTERFUNCTION       CHARACTER#FUNCTION DEF 
  54.      +99 0 0 0 2 0 1  1  3  6 17 21  2  0 19'/                          DEF 
  55.       DATA SDESCR( 13)/' 8 0 CHARACTER               CHARACTER*@        DEF 
  56.      +99 0 0 0 2 0 0 10  2  6 18  0  0  0  0'/                          DEF 
  57.       DATA SDESCR( 14)/' 8 0 CHARACTER               DITO               DEF 
  58.      +99 0 0 0 2 2 0 10  2  6 18  0  0  0  0'/                          DEF 
  59.       DATA SDESCR( 15)/'10 0 CLOSE                   DITO               DEF 
  60.      +99 0 4 1 2 3 0  0  2  0 17  0  0  0  0'/                          DEF 
  61.       DATA SDESCR( 16)/'16 0 DATA                    DITO               DEF 
  62.      +99 0 0 0 2 2 0  0  1  0  0  0  0  0  0'/                          DEF 
  63.       DATA SDESCR( 17)/'19 0 DIMENSION               DITO               DEF 
  64.      +99 0 0 0 2 2 0 10  2  0 18  0  0  0  0'/                          DEF 
  65.       DATA SDESCR( 18)/'20 1 DO                      DO@,               DEF 
  66.      + 3 0 1 1 2 0 0  0  2  0 17  0  0  0  0'/                          DEF 
  67.       DATA SDESCR( 19)/'20 2 DO                      DO@?=!,            DEF 
  68.      + 3 0 1 1 2 0 0  0  2  0 17  0  0  0  0'/                          DEF 
  69.       DATA SDESCR( 20)/'17 0 DECODE                  DITO               DEF 
  70.      +99 0 4 1 2 2 0  0  2  0 17  0  0  0  0'/                          DEF 
  71.       DATA SDESCR( 21)/'22 0 DOUBLEPRECISIONFUNCTION DITO               DEF 
  72.      +99 0 0 0 2 2 1  1  3  5 17 21  2  0 19'/                          DEF 
  73.       DATA SDESCR( 22)/'21 0 DOUBLEPRECISION         DITO               DEF 
  74.      +99 0 0 0 2 2 0 10  2  5 18  0  0  0  0'/                          DEF 
  75.       DATA SDESCR( 23)/'26 0 END                     END;               DEF 
  76.      +99 0 0 1 0 0 0  0  0  0  0  0  0  0  0'/                          DEF 
  77.       DATA SDESCR( 24)/'27 0 ENDIF                   DITO               DEF 
  78.      +99 0 0 1 0 2 0  0  0  0  0  0  0  0  0'/                          DEF 
  79.       DATA SDESCR( 25)/'28 0 ENDFILE                 DITO               DEF 
  80.      +99 0 0 1 2 2 0  0  2  0 17  0  0  0  0'/                          DEF 
  81.       DATA SDESCR( 26)/'29 0 ENTRY                   DITO               DEF 
  82.      +99 0 0 0 2 2 0  1  2  0 16  1  0  0  0'/                          DEF 
  83.       DATA SDESCR( 27)/'30 0 EQUIVALENCE             DITO               DEF 
  84.      +99 0 0 0 2 2 0  0  1  0  0  0  0  0  0'/                          DEF 
  85.       DATA SDESCR( 28)/'31 0 EXTERNAL                DITO               DEF 
  86.      +99 0 0 0 2 2 0  0  1 12  0  0  0  0  0'/                          DEF 
  87.       DATA SDESCR( 29)/'23 0 ELSE                    ELSE;              DEF 
  88.      +99 0 0 1 0 0 0  0  0  0  0  0  0  0  0'/                          DEF 
  89.       DATA SDESCR( 30)/'24 0 ELSEIF                  ELSEIF(>)THEN;     DEF 
  90.      + 6 4 0 1 2 0 0  0  2  0 17  0  0  0  0'/                          DEF 
  91.       DATA SDESCR( 31)/'25 0 ENCODE                  DITO               DEF 
  92.      +99 0 4 1 2 2 0  0  2  0 17  0  0  0  0'/                          DEF 
  93.       DATA SDESCR( 32)/'33 0 FORMAT                  DITO               DEF 
  94.      +99 0 0 0 0 2 0  0  0  0  0  0  0  0  0'/                          DEF 
  95.       DATA SDESCR( 33)/'34 0 FUNCTION                DITO               DEF 
  96.      +99 0 0 0 2 2 1  1  2  0 17  2  0 19  0'/                          DEF 
  97.       DATA SDESCR( 34)/'37 0 GOTO-(UNCOND.)          GOTO@              DEF 
  98.      +99 0 1 1 0 0 0  0  0  0  0  0  0  0  0'/                          DEF 
  99.       DATA SDESCR( 35)/'36 0 GOTO-(COMP.)            GOTO(              DEF 
  100.      +99 0 2 1 2 2 0  0  2  0 17  0  0  0  0'/                          DEF 
  101.       DATA SDESCR( 36)/'35 0 GOTO-(ASS.)             GOTO&              DEF 
  102.      + 4 0 2 1 2 0 0  0  1  0  0  0  0  0  0'/                          DEF 
  103.       DATA SDESCR( 37)/'39 0 IF-(BLOCK)              IF(>)THEN;         DEF 
  104.      + 3 4 0 1 2 0 0  0  2  0 17  0  0  0  0'/                          DEF 
  105.       DATA SDESCR( 38)/'40 0 IF-(LOGICAL)            IF(>)&             DEF 
  106.      + 3 0 0 1 2 0 0  0  2  0 17  0  0  0  0'/                          DEF 
  107.       DATA SDESCR( 39)/'38 0 IF-(ARITM.)             IF(>)@             DEF 
  108.      + 3 0 3 1 2 0 0  0  2  0 17  0  0  0  0'/                          DEF 
  109.       DATA SDESCR( 40)/'69 0 ILLEGAL                                    DEF 
  110.      + 0 0 0 0 0 0 0  0  0  0  0  0  0  0  0'/                          DEF 
  111.       DATA SDESCR( 41)/'44 0 INTEGERFUNCTION         DITO               DEF 
  112.      +99 0 0 0 2 2 1  1  3  1 17 21  2  0 19'/                          DEF 
  113.       DATA SDESCR( 42)/'43 0 INTEGER                 INTEGER*@          DEF 
  114.      +99 0 0 0 2 0 0 10  2  1 18  0  0  0  0'/                          DEF 
  115.       DATA SDESCR( 43)/'43 0 INTEGER                 DITO               DEF 
  116.      +99 0 0 0 2 2 0 10  2  1 18  0  0  0  0'/                          DEF 
  117.       DATA SDESCR( 44)/'41 0 IMPLICIT                DITO               DEF 
  118.      +99 0 0 0 0 2 0  2  0  0  0  0  0  0  0'/                          DEF 
  119.       DATA SDESCR( 45)/'42 0 INQUIRE                 DITO               DEF 
  120.      +99 0 4 1 2 3 0  0  1  0  0  0  0  0  0'/                          DEF 
  121.       DATA SDESCR( 46)/'45 0 INTRINSIC               DITO               DEF 
  122.      +99 0 0 0 2 2 0  0  1 11  0  0  0  0  0'/                          DEF 
  123.       DATA SDESCR( 47)/'48 0 LOGICALFUNCTION         DITO               DEF 
  124.      +99 0 0 0 2 2 1  1  3  3 17 21  2  0 19'/                          DEF 
  125.       DATA SDESCR( 48)/'47 0 LOGICAL                 LOGICAL*@          DEF 
  126.      +99 0 0 0 2 0 0 10  2  3 18  0  0  0  0'/                          DEF 
  127.       DATA SDESCR( 49)/'47 0 LOGICAL                 DITO               DEF 
  128.      +99 0 0 0 2 2 0 10  2  3 18  0  0  0  0'/                          DEF 
  129.       DATA SDESCR( 50)/'46 0 LEVEL                   DITO               DEF 
  130.      +99 0 0 0 2 2 0  0  1  0  0  0  0  0  0'/                          DEF 
  131.       DATA SDESCR( 51)/'49 0 NAMELIST                DITO               DEF 
  132.      +99 0 0 0 2 2 0  1  1  9  1  0  0  0  0'/                          DEF 
  133.       DATA SDESCR( 52)/'50 0 OPEN                    DITO               DEF 
  134.      +99 0 4 1 2 3 0  0  1  0  0  0  0  0  0'/                          DEF 
  135.       DATA SDESCR( 53)/'54 0 PRINT                   DITO               DEF 
  136.      +99 0 1 1 2 2 0  0  2  0 17  0  0  0  0'/                          DEF 
  137.       DATA SDESCR( 54)/'52 0 PARAMETER               DITO               DEF 
  138.      +99 0 0 0 2 2 0  0  2  0  7  0  0  0  0'/                          DEF 
  139.       DATA SDESCR( 55)/'53 0 PAUSE                   DITO               DEF 
  140.      +99 0 0 1 0 2 0  0  0  0  0  0  0  0  0'/                          DEF 
  141.       DATA SDESCR( 56)/'55 0 PROGRAM                 DITO               DEF 
  142.      +99 0 0 0 1 2 1  0  1 13  0  0  0  0  0'/                          DEF 
  143.       DATA SDESCR( 57)/'56 0 PUNCH                   DITO               DEF 
  144.      +99 0 1 1 2 2 0  0  2  0 17  0  0  0  0'/                          DEF 
  145.       DATA SDESCR( 58)/'58 0 READ(                   DITO               DEF 
  146.      +99 0 4 1 2 3 0  0  2  0 17  0  0  0  0'/                          DEF 
  147.       DATA SDESCR( 59)/'57 0 READ                    DITO               DEF 
  148.      +99 0 1 1 2 2 0  0  2  0 17  0  0  0  0'/                          DEF 
  149.       DATA SDESCR( 60)/'60 0 REALFUNCTION            DITO               DEF 
  150.      +99 0 0 0 2 2 1  1  3  2 17 21  2  0 19'/                          DEF 
  151.       DATA SDESCR( 61)/'59 0 REAL                    REAL*@             DEF 
  152.      +99 0 0 0 2 0 0 10  2  2 18  0  0  0  0'/                          DEF 
  153.       DATA SDESCR( 62)/'59 0 REAL                    DITO               DEF 
  154.      +99 0 0 0 2 2 0 10  2  2 18  0  0  0  0'/                          DEF 
  155.       DATA SDESCR( 63)/'61 0 RETURN                  DITO               DEF 
  156.      +99 0 0 1 0 2 0  0  0  0  0  0  0  0  0'/                          DEF 
  157.       DATA SDESCR( 64)/'62 0 REWIND                  DITO               DEF 
  158.      +99 0 0 1 2 2 0  0  2  0 17  0  0  0  0'/                          DEF 
  159.       DATA SDESCR( 65)/'63 0 SAVE                    DITO               DEF 
  160.      +99 0 0 0 2 2 0  0  1  0  0  0  0  0  0'/                          DEF 
  161.       DATA SDESCR( 66)/'65 0 STOP                    DITO               DEF 
  162.      +99 0 0 1 0 2 0  0  0  0  0  0  0  0  0'/                          DEF 
  163.       DATA SDESCR( 67)/'66 0 SUBROUTINE              DITO               DEF 
  164.      +99 0 0 0 2 2 1  1  1 15  2  0 19  0  0'/                          DEF 
  165.       DATA SDESCR( 68)/'68 0 WRITE                   DITO               DEF 
  166.      +99 0 4 1 2 3 0  0  2  0 17  0  0  0  0'/                          DEF 
  167.       DATA SDESCR( 69)/' 2 3 ASSIGNMENT              ?=                 DEF 
  168.      + 0 0 0 1 2 0 0  1  1  0  2  0 17  0  0'/                          DEF 
  169.       DATA SDESCR( 70)/' 2 4 ASSIGNMENT              ?(>)=              DEF 
  170.      + 0 0 0 1 2 0 0  1  2  0 10  2  0 17  0'/                          DEF 
  171.       DATA SDESCR( 71)/' 2 5 ASSIGNMENT              ?(>)(>)=           DEF 
  172.      + 0 0 0 1 2 0 0  1  1  0  2  0 17  0  0'/                          DEF 
  173.       DATA SLAST/' '/   
  174.       DATA DOITFL/.TRUE./   
  175.       include 'CONDAT.h' 
  176. *   
  177. *--- do it only once
  178. *   
  179.       IF(DOITFL)  THEN  
  180.          DOITFL=.FALSE. 
  181.          NHEADR=0   
  182.          NPRIOR=0   
  183.          NPNAM=0
  184.          NPSTM=0
  185.          NCLASS=MXSTAT  
  186.          DO 10 I=1,27   
  187.             IALPHA(1,I)=0   
  188.             IALPHA(2,I)=-1  
  189.    10    CONTINUE   
  190.          DO 30 I=1,MXSTAT   
  191.             READ (SDESCR(I),'(2I2,44X,7I2,10I3)') (ISTMDS(J,I),J=6, 
  192.      +      MCLASS) 
  193.             NP=ISTMDS(7,I)  
  194.             IF (NP.GT.0.AND.NP.LE.NCLASS)  THEN 
  195.                NPRIOR=NPRIOR+1  
  196.                IPRIOR(NP)=I 
  197.             ENDIF   
  198.             READ (SDESCR(I),'(5X,A24,A20)') STR1,STR2   
  199.             NST1=INDEX(STR1,' ')-1  
  200.             NST2=INDEX(STR2,' ')-1  
  201.             SNAM(NPNAM+1:NPNAM+NST1)=STR1   
  202.             ISTMDS(1,I)=NPNAM+1 
  203.             NPNAM=NPNAM+NST1
  204.             ISTMDS(2,I)=NPNAM   
  205.             IF (NST2.EQ.0)  THEN
  206. *--- statement descriptor blank - indicate  
  207.                ISTMDS(3,I)=0
  208.                IF (ISTMDS(6,I).EQ.69) ILL=I 
  209.             ELSEIF (STR2(1:4).EQ.'DITO')  THEN  
  210. *--- use name as descriptor 
  211.                SSTM(NPSTM+1:NPSTM+NST1)=STR1
  212.                ISTMDS(3,I)=NPSTM+1  
  213.                NPSTM=NPSTM+NST1 
  214.                ISTMDS(4,I)=NPSTM
  215.             ELSE
  216.                SSTM(NPSTM+1:NPSTM+NST2)=STR2
  217.                ISTMDS(3,I)=NPSTM+1  
  218.                NPSTM=NPSTM+NST2 
  219.                ISTMDS(4,I)=NPSTM
  220.             ENDIF   
  221. *--- set some class references  
  222.             IF (ISTMDS(6,I).EQ.40)  THEN
  223. *--- logical IF 
  224.                IIF=I
  225.             ELSEIF (ISTMDS(6,I).EQ.26)  THEN
  226. *--- END statement  
  227.                IEND=I   
  228.             ELSEIF (ISTMDS(6,I).EQ.33)  THEN
  229. *--- FORMAT 
  230.                IFORMT=I 
  231.             ELSEIF (ISTMDS(6,I).EQ.61)  THEN
  232. *--- RETURN 
  233.                IRETUR=I 
  234.             ENDIF   
  235. *--- get start of alphabetic group  
  236.             STEMP=SSTM(ISTMDS(3,I):)
  237.             IF (ISTMDS(3,I).NE.0)  THEN 
  238.                IF (STEMP.NE.SLAST)  THEN
  239.                   IF (SPECCH(STEMP))  THEN  
  240.                      K=27   
  241.                   ELSE  
  242.                      K=ICVAL(STEMP) 
  243.                   ENDIF 
  244.                   IALPHA(1,K)=I 
  245.                   IF (SLAST.NE.' ')  THEN   
  246.                      K=ICVAL(SLAST) 
  247.                      IALPHA(2,K)=I-1
  248.                   ENDIF 
  249.                   SLAST=STEMP   
  250.                ENDIF
  251.             ENDIF   
  252.             K=ISTMDS(3,I)-1 
  253. *--- find and store last alphabetic ch. in descr.   
  254.             DO 20 J=ISTMDS(3,I),ISTMDS(4,I) 
  255.                IF (ALPHCH(SSTM(J:J))) K=J   
  256.    20       CONTINUE
  257.             ISTMDS(5,I)=K   
  258. *--- routine headers
  259.             IF (ISTMDS(14,I).NE.0)  THEN
  260.                NHEADR=NHEADR+1  
  261.                IHEADR(NHEADR)=I 
  262.             ENDIF   
  263.    30    CONTINUE   
  264.          IALPHA(2,27)=NCLASS
  265. *--- end of IF(DOITFL)  following   
  266.       ENDIF 
  267.       END   
  268.